home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Workbench Add-On
/
Workbench Add-On - Volume 1.iso
/
Dev
/
Oberon
/
source
/
OC
/
OCOut.mod
< prev
next >
Wrap
Text File
|
1995-07-02
|
4KB
|
152 lines
(*************************************************************************
$RCSfile: OCOut.mod $
Description: Machine-specific declarations and operations.
Created by: fjc (Frank Copeland)
$Revision: 5.1 $
$Author: fjc $
$Date: 1995/05/19 15:57:52 $
Copyright © 1995, Frank Copeland
This module forms part of the OC program
See OC.doc for conditions of use and distribution
Log entries are at the end of the file.
*************************************************************************)
<* STANDARD- *> <* MAIN- *>
MODULE OCOut;
IMPORT
SYS := SYSTEM, Kernel, e := Exec, d := Dos, du := DosUtil,
WbConsole, s := OCStrings;
(*
** Console I/O
*)
(*------------------------------------*)
PROCEDURE Str* ( string : ARRAY OF CHAR );
<*$CopyArrays-*>
BEGIN (* Str *)
du.HaltIfBreak ({d.ctrlC});
IF d.PutStr (string) = 0 THEN END;
IF d.Flush (d.Output()) THEN END
END Str;
(*------------------------------------*)
PROCEDURE Ln*;
BEGIN (* Ln *)
du.HaltIfBreak ({d.ctrlC});
IF d.PutStr ("\n") = 0 THEN END;
END Ln;
(*------------------------------------*)
PROCEDURE Char* ( c : CHAR );
BEGIN (* Char *)
du.HaltIfBreak ({d.ctrlC});
d.PrintF ("%lc", c);
IF d.Flush (d.Output()) THEN END
END Char;
(*------------------------------------*)
PROCEDURE Int* ( i : LONGINT );
BEGIN (* Int *)
du.HaltIfBreak ({d.ctrlC});
d.PrintF ("%ld", i);
IF d.Flush (d.Output()) THEN END
END Int;
(*------------------------------------*)
PROCEDURE Str0* ( n : LONGINT );
VAR string : e.LSTRPTR;
BEGIN (* Str0 *)
du.HaltIfBreak ({d.ctrlC});
string := s.GetString (n);
IF d.PutStr (string^) = 0 THEN END;
IF d.Flush (d.Output()) THEN END
END Str0;
(*------------------------------------*)
PROCEDURE Str1* ( n : LONGINT; string : ARRAY OF CHAR );
VAR format : e.LSTRPTR;
<*$CopyArrays-*>
BEGIN (* Str1 *)
du.HaltIfBreak ({d.ctrlC});
format := s.GetString (n);
d.PrintF (format^, SYS.ADR (string));
IF d.Flush (d.Output()) THEN END
END Str1;
(*------------------------------------*)
PROCEDURE Int3* ( n, i1, i2, i3 : LONGINT );
VAR format : e.LSTRPTR;
BEGIN (* Int3 *)
du.HaltIfBreak ({d.ctrlC});
format := s.GetString (n);
d.PrintF (format^, i1, i2, i3);
IF d.Flush (d.Output()) THEN END
END Int3;
(*------------------------------------*)
PROCEDURE Int4* ( n, i1, i2, i3, i4 : LONGINT );
VAR format : e.LSTRPTR;
BEGIN (* Int4 *)
du.HaltIfBreak ({d.ctrlC});
format := s.GetString (n);
d.PrintF (format^, i1, i2, i3, i4);
IF d.Flush (d.Output()) THEN END
END Int4;
(*------------------------------------*)
PROCEDURE* PutCh ();
<*$EntryExitCode-*>
BEGIN (* PutCh *)
SYS.INLINE (16C0H, (* MOVE.B D0,(A3)+ *)
4E75H) (* RTS *)
END PutCh;
(*------------------------------------*)
PROCEDURE FmtInt3* ( n, i1, i2, i3 : LONGINT; VAR string : ARRAY OF CHAR );
VAR format : e.LSTRPTR; t : LONGINT;
BEGIN (* FmtInt3 *)
format := s.GetString (n);
t := i1; i1 := i3; i3 := t;
e.OldRawDoFmtL (format^, i3, PutCh, SYS.ADR (string));
END FmtInt3;
(*------------------------------------*)
PROCEDURE* Cleanup (VAR rc : LONGINT);
BEGIN (* Cleanup *)
s.CloseCatalog()
END Cleanup;
BEGIN
Kernel.SetCleanup (Cleanup);
s.OpenCatalog (NIL, "");
END OCOut.
(***************************************************************************
$Log: OCOut.mod $
# Revision 5.1 1995/05/19 15:57:52 fjc
# - Initial revision
# - Moved console IO code out of OCM.
#
***************************************************************************)